home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / FILES.SWG / 0061_DelTree Equivalent.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  2KB  |  71 lines
  1. {
  2.   Erase is the proper procedure to delete one file. Here's a program I
  3.   wrote a while back that does the same thin DELTREE does. Look it over
  4.   and see if it helps get you started. BTW, I modified this a bit to
  5.   remove commercial lib refs so there may be a syntax bug or two...
  6.  
  7.   RFD.PAS - Copyright 1991 Steve Rogers
  8.   Released to public domain since DOS6 has DelTree... :)
  9. }
  10.  
  11. {$m 16384,0,8192}
  12. {$i-}
  13.  
  14. uses
  15.   crt,dos;
  16.  
  17. {-----------------------}
  18. function rfd(const s : pathstr) : boolean;
  19. var
  20.   f : file;
  21.   d : searchrec;
  22.   temp : boolean;
  23.  
  24. begin
  25.   writeln('Removing '+s+'\');
  26.  
  27.   findfirst(s+'\*.*',anyfile-directory,d);
  28.   if (doserror=0) then begin
  29.  
  30.     { Use DOS to get rid of the lion's share of files }
  31.     swapvectors;
  32.     exec(getenv('COMSPEC'),'echo y|del '+s+'\*.* >nul');
  33.     swapvectors;
  34.  
  35.     { Now get the stragglers }
  36.     findfirst(s+'\*.*',anyfile-directory,d);
  37.     while (doserror=0) do begin
  38.       assign(f,s+'\'+d.name);
  39.       setfattr(f,archive);
  40.       erase(f);
  41.       findnext(d);
  42.     end;
  43.   end;
  44.  
  45.   { Now process the subs }
  46.   findfirst(s+'\*.*',directory,d);
  47.   while (doserror=0) do begin
  48.     if (d.attr and directory = directory) and (d.name[1]<>'.') then
  49.       temp:= rfd(s+'\'+d.name);
  50.     findnext(d);
  51.   end;
  52.  
  53.   rmdir(s);
  54.   rfd:= (ioresult=0);
  55. end;
  56.  
  57. {-----------------------}
  58. begin
  59.   clrscr;
  60.   writeln('RFD - Remove Full Directory  Copyright 1991 Steve Rogers');
  61.  
  62.   if (paramcount<1) then
  63.     writeln('Syntax is: RFD <directory>')
  64.   else begin
  65.     if rfd(paramstr(1)) then
  66.       writeln(paramstr(1)+' removed. All files and subs deleted.')
  67.     else
  68.       writeln('Unable to find or remove '+paramstr(1));
  69.   end;
  70. end.
  71.